home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Almathera Ten Pack 3: CDPD 3
/
Almathera Ten on Ten - Disc 3: CDPD3.iso
/
scope
/
001-025
/
scopedisk24
/
amycal
/
cal.mod
< prev
next >
Wrap
Text File
|
1995-03-18
|
5KB
|
217 lines
MODULE Cal;
(* A calendar making program written in Benchmark Modula-2.
Cal is a 100% public domain, do-what-you-will program for
all Amiga computers. Written by David Czaya (PLINK -Dave- )
in July 1988.
If you feel obliged, leave my name in any modications. If not,
don't lose any sleep. Thanks.
The day of the week that the first of the month falls on
is determined by Zeller's Congruence. This works for any
date since 1582.
wkday = (d + m*2 + INT((m+1)*.6) + 1 + yr +
INT(yr/4) - INT(yr/100) + INT(yr/400)) MOD 7
wkday = weekday (0=Sun, 1=Mon, 2=Tue, etc.)
d = day of the month
m = adjusted month (Jan & Feb = 13 & 14 of previous year)
yr = adjusted year ((yr = yr-1) if month is Jan. or Feb.)
*)
FROM SYSTEM IMPORT ADR, SHORT;
FROM System IMPORT argc, argv;
FROM TermInOut IMPORT WriteString, WriteCard, WriteLn, Write;
FROM Conversions IMPORT ConvStringToNumber;
FROM CStrings IMPORT strncmp;
FROM AmigaDOS IMPORT DateStamp, DateStampRecord;
CONST
COLORVID = '\033[33m';
NORMVID = '\033[m';
CURSOROFF = '\033[0 p\n';
CURSORON = '\033[ p\n';
USAGE =
'\tUsage: Cal [month] [year]\n\
\t ex: Cal January 1988\n\n\
\t100% public domain by David Czaya July 1988\n';
VAR
yr, monthptr, (* monthptr is month array pointer *)
day, wkday,
monthlen : CARDINAL;
month : ARRAY [1..12],[0..9] OF CHAR;
leap : BOOLEAN;
yy : LONGCARD;
dsrecord : DateStampRecord;
PROCEDURE Err1();
BEGIN
WriteString(USAGE);
HALT
END Err1;
PROCEDURE Err2(); (* \7 flashes the screen *)
BEGIN
WriteString('\7 *** The year must be between 1592 and 9999\n');
HALT
END Err2;
PROCEDURE ConvArg1(); (* check for valid "month" input *)
BEGIN
FOR monthptr := 0 TO 2 DO
argv^[1]^[monthptr] := CAP(argv^[1]^[monthptr]);
END;
FOR monthptr := 1 TO 12 DO
IF strncmp(ADR(argv^[1]^),ADR(month[monthptr]),3) = 0 THEN
RETURN
END;
END;
Err1();
END ConvArg1;
PROCEDURE ConvArg2();
BEGIN (* check for valid "year" input, *)
leap := FALSE; (* check for leap year and see *)
monthlen := 31; (* how many days are in the *)
yr := SHORT(yy); (* month *)
IF (yr < 100) THEN INC(yr,1900) END;
IF (yr < 1592) OR (yr > 9999) THEN Err2() END;
IF (yr MOD 4) = 0 THEN leap := TRUE END;
IF (yr MOD 100) = 0 THEN leap := FALSE END;
IF (yr MOD 400) = 0 THEN leap := TRUE END;
IF monthptr = 2 THEN monthlen := 28 END;
IF leap AND (monthptr = 2) THEN INC(monthlen) END;
IF (monthptr = 4) OR (monthptr = 6) OR
(monthptr = 9) OR (monthptr = 11) THEN DEC(monthlen) END;
END ConvArg2;
PROCEDURE GetSysDate(date: DateStampRecord);
VAR
n,y,m,d : CARDINAL;
BEGIN
n := date.dsDays - 2251D;
y := (4 * n + 3) DIV 1461;
n := n - ((1461 * y) DIV 4);
y := y + 1984;
m := ((5 * n + 2) DIV 153);
d := n - (153 * m + 2) DIV 5 + 1;
INC(m,3);
IF m > 12 THEN
INC(y);
DEC(m,12);
END;
monthptr := m;
day := d;
yy := y;
END GetSysDate;
PROCEDURE GetDay(); (* find out what day of the week *)
VAR (* the month starts on, using *)
m,d,y : CARDINAL; (* Zeller's Congruence *)
BEGIN
m := monthptr;
d := 1;
y := yr;
IF m < 3 THEN
INC(m,12);
DEC(y);
END;
wkday := (d + m * 2 + CARDINAL(TRUNC((FLOAT(m) + 1.0) * 0.6)) + 1 + y +
(y DIV 4) - (y DIV 100) + (y DIV 400) ) MOD 7;
END GetDay;
PROCEDURE PrintCal(); (* format and print calendar *)
VAR
len, ctr : CARDINAL;
BEGIN
len := 0;
WHILE month[monthptr][len] # '\0' DO INC(len) END;
WriteString(CURSOROFF);
FOR ctr := 1 TO ((21-(len+4)) DIV 2) DO Write(40C) END;
WriteString(month[monthptr]);
WriteCard(yr,5);
WriteString('\n\n Su Mo Tu We Th Fr Sa\n\n');
FOR ctr := 1 TO wkday DO
WriteString(' ');
END;
FOR ctr := wkday TO monthlen+wkday-1 DO
IF (ctr = 7) OR (ctr = 14) OR (ctr = 21) OR
(ctr = 28) OR (ctr = 35) THEN
WriteLn;
END;
IF (ctr-wkday+1) # day THEN
WriteCard(ctr-wkday+1,3)
ELSE
WriteString(COLORVID);
WriteCard(ctr-wkday+1,3);
WriteString(NORMVID);
END;
END;
WriteString(CURSORON);
END PrintCal;
BEGIN
month[01]:= 'JANUARY';
month[02]:= 'FEBRUARY';
month[03]:= 'MARCH';
month[04]:= 'APRIL';
month[05]:= 'MAY';
month[06]:= 'JUNE';
month[07]:= 'JULY';
month[08]:= 'AUGUST';
month[09]:= 'SEPTEMBER';
month[10]:= 'OCTOBER';
month[11]:= 'NOVEMBER';
month[12]:= 'DECEMBER';
(* Start here *)
CASE argc OF
1 : DateStamp(dsrecord);
GetSysDate(dsrecord) |
2 : Err1() |
3 : IF NOT ConvStringToNumber(argv^[2]^,yy,FALSE,10) THEN Err1()
ELSE ConvArg1() END
ELSE
Err1();
END;
ConvArg2();
GetDay();
PrintCal();
END Cal.